home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / random / TstrndU1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-03-18  |  4.1 KB  |  127 lines
  1. {*********************************************************}
  2. {* TstRndU1                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Random number test program - User Interface           *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit TstRndU1;
  14.  
  15. interface
  16.  
  17. uses
  18.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  19.   StdCtrls, TstRndU2, TstRndU3;
  20.  
  21. type
  22.   TForm1 = class(TForm)
  23.     ListBox1: TListBox;
  24.     Label1: TLabel;
  25.     Button1: TButton;
  26.     Memo1: TMemo;
  27.     Results: TLabel;
  28.     Button2: TButton;
  29.     ShowChi: TCheckBox;
  30.     procedure Button2Click(Sender: TObject);
  31.     procedure Button1Click(Sender: TObject);
  32.     procedure FormActivate(Sender: TObject);
  33.     procedure FormDeactivate(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.     RandGen : TRandomGenerator;
  37.   public
  38.     { Public declarations }
  39.     procedure PrintChiSqaureResults(TestName    : string;
  40.                                     ChiSquare   : double;
  41.                                     DegsFreedom : integer);
  42.   end;
  43.  
  44. var
  45.   Form1: TForm1;
  46.  
  47. implementation
  48.  
  49. {$R *.DFM}
  50.  
  51. procedure TForm1.FormActivate(Sender: TObject);
  52. begin
  53.   Listbox1.ItemIndex := 0;
  54.   InitializeAdditiveGenerator;
  55. end;
  56.  
  57. procedure TForm1.Button2Click(Sender: TObject);
  58. begin
  59.   Memo1.Clear;
  60. end;
  61.  
  62. procedure TForm1.Button1Click(Sender: TObject);
  63. var
  64.   ChiSquare   : double;
  65.   DegsFreedom : integer;
  66. begin
  67.   if (ListBox1.ItemIndex <> -1) then begin
  68.     case ListBox1.ItemIndex of
  69.       0 : RandGen := SystemRandom;
  70.       1 : RandGen := AlgorithmK;
  71.       2 : RandGen := AdditiveGenerator;
  72.     end;
  73.     Memo1.Text := Memo1.Text +
  74.                   Format('===%s===', [ListBox1.Items[ListBox1.ItemIndex]]) + ^M^J;
  75.     {the uniformity test}
  76.     UniformityTest(RandGen, ChiSquare, DegsFreedom);
  77.     PrintChiSqaureResults('Uniformity Test', ChiSquare, DegsFreedom);
  78.     {the various gap tests}
  79.     GapTest(RandGen, 0.0, 0.5, ChiSquare, DegsFreedom);
  80.     PrintChiSqaureResults('Gap Test (0.0 - 0.5)', ChiSquare, DegsFreedom);
  81.     GapTest(RandGen, 0.5, 1.0, ChiSquare, DegsFreedom);
  82.     PrintChiSqaureResults('Gap Test (0.5 - 1.0)', ChiSquare, DegsFreedom);
  83.     GapTest(RandGen, 0.0, 1.0/3.0, ChiSquare, DegsFreedom);
  84.     PrintChiSqaureResults('Gap Test (0.0 - 0.33)', ChiSquare, DegsFreedom);
  85.     GapTest(RandGen, 1.0/3.0, 2.0/3.0, ChiSquare, DegsFreedom);
  86.     PrintChiSqaureResults('Gap Test (0.33 - 0.67)', ChiSquare, DegsFreedom);
  87.     GapTest(RandGen, 2.0/3.0, 1.0, ChiSquare, DegsFreedom);
  88.     PrintChiSqaureResults('Gap Test (0.67 - 1.0)', ChiSquare, DegsFreedom);
  89.     {the poker test}
  90.     PokerTest(RandGen, ChiSquare, DegsFreedom);
  91.     PrintChiSqaureResults('Poker Test', ChiSquare, DegsFreedom);
  92.     {the coupon collectors test}
  93.     CouponCollectorsTest(RandGen, ChiSquare, DegsFreedom);
  94.     PrintChiSqaureResults('Coupon Collectors Test', ChiSquare, DegsFreedom);
  95.   end;
  96. end;
  97.  
  98. procedure TForm1.PrintChiSqaureResults(TestName    : string;
  99.                                        ChiSquare   : double;
  100.                                        DegsFreedom : integer);
  101. var
  102.   TestResult : string;
  103. begin
  104.   if (ChiTable5[DegsFreedom] <= ChiSquare) and
  105.      (ChiSquare <= ChiTable95[DegsFreedom]) then
  106.     TestResult := 'Success'
  107.   else
  108.     TestResult := '**FAILED**';
  109.  
  110.   if ShowChi.Checked then
  111.     Memo1.Text := Memo1.Text +
  112.                   Format('%s', [TestName]) + ^M^J +
  113.                   Format('[Chi-Square %f, DegsFreedom %d]',
  114.                          [ChiSquare, DegsFreedom]) + ^M^J +
  115.                   TestResult + ^M^J
  116.   else
  117.     Memo1.Text := Memo1.Text +
  118.                   Format('%s: %s', [TestName, TestResult]) + ^M^J;
  119. end;
  120.  
  121. procedure TForm1.FormDeactivate(Sender: TObject);
  122. begin
  123.   DestroyAdditiveGenerator;
  124. end;
  125.  
  126. end.
  127.